Analiza teksta
Analiza teksta dobiva na popularnosti zbog sve veće dostupnosti podataka i razvoja user friendly podrške za provedbu takve analize. Konceptualni pregled analize teksta ya sociologe je dostupan i u nedavno objavljenoj knjizi, koja se preporuča tek nakon savladavanja osnovnih tehničkih vještina i alata za obradu teksta. Provedba analize tekstualnih podataka je moguća na mnogo načina, a najšire korišten pristup je bag-of-words u kojem je frekvencija riječi polazište za analizu dok se (npr.) pozicija riječi u rečenici ili paragrafu zanemaruje. Bag of words pristup je ujedno i najjednostavniji (konceptualno i računarski) pa će biti korišten u ovom predavanju.
Postupak analize teksta započinje pripremom teksta (podataka), koja je često dosta zahtjevna i uključuje: uvoz teksta, operacije sa riječima, uređivanje i tokenizaciju, izradu matrice pojmova, filtiranje i ponderiranje podataka. Pri tome valja imati na umu da vrsta analize i korištena metoda određuju način na koji je potrebno pripremiti podatke za daljnu analizu te da svaka metoda ima svoje specifičnosti. Nakon pripreme podataka se vrši analiza teksta (podataka) metodama nadziranog strojnog učenja, ne-nadziranog strojnog učenja, statistike na tekstualnim podatcima, analize riječnika, analize sentimenta. Napredne metode analize podataka uključuju NLP, analizu pozicije riječi i sintakse…Sažeti prikaz workflow-a za analizu teksta izgleda ovako:
Procedura za analizu teksta.
Software i korisni resursi
U ovom predavanju ćemo koristiti tidytext pristup (i istoimeni paket) za analizu tekstualnih podatka, detaljno opisan u knjizi Text Mining with R. Ovaj paket služi kako bismo tekstualne podatke “uveli” u tidyverse ovir pomoću kojeg je moguće nestrukturirani tekst analizirati sa otprije poznatim alatima iz dplyr i ggplot paketa. Učitajmo potrebne pakete:
library(tidyverse)
library(tidytext)
library(data.table)
library(lubridate)
library(grid)
library(wordcloud)
library(reshape2)
library(igraph)
library(ggraph)
library(widyr)
library(topicmodels)
library(ggthemes)
library(DT)
library(kableExtra)
library(ggplot2)
library(ggthemes)
library(scales)
library(tidyverse)
library(httr)
library(lubridate)
library(dplyr)
library(data.table)
library(tidytext)
library(plotly)
library(readxl)Prije opisa podataka koje ćemo koristiti valja naglasiti da tidytext pristup nije jedini način za rad s podatcima u R. Ovdje ga koristimo jer je kompatibilan sa pristupima koje smo do sada koristili u okviru ovog kolegija. Drugi paketi (pristupi) za rad sa tekstom u R su:
quantedaje sveobuhvatan i funkcijama bogat paket, neophodan u za složeniju analizu teksta. Izvrstan tutorial je dostupan na linku.text2vecje izrazito koristan paket za ML algoritme sa tekstualnim podatcima. Posebno je pogodan za izradu dtm i tcm matrica. Paket je motiviran python-ovom Gensim knjižnicom, a tutorial je dostupan na linku.stringrpaket je neophodan za manipulaciju string podataka u R i kao diotidyversesvijeta će biti izrazito koristan u čišćenju i pripremi podataka. Vrlo je praktičan za rad sa regex-om i ima nekoliko izvrsnih funkcija za pattern matching. Službeni R Tutorial je dostupan na linku.spacyrje wrapper paket za spaCy knjižnicu iz python-a i omogućava provedbu naprednijih NLP modela (deep learning, speech tagging, tkoenization, parsing) u R. Također je kompatibilan sa quanteda i tidytext paketima. Tutorial je dostupan na linku.za one koji žele znati više mogu biti korisni i sljedeći resursi: vodič za tekstualnu analizu u R i kolegij za obradu prirodnog teksta u najstajnju koji sadrži i mnoštvo referenci.
Podatci
Svaka analiza (teksta) počinje od podataka. Pribava tekstualnih podataka o specifičnim temama najčešće nije jednostavna. Najčešći je način preuzimanja podataka neki od dostupnih API servisa za novinske članke ili tekstualnih repozitorija ili servisi poput Twitter-a. No to često nije dovoljno ukolilko želimo analizirati specifičnu temu ili temu na specifičnom jeziku (npr. hrvatskom). Ovdje još valja napomeniti da je preuzimanje kvalitetnih tekstualnih podataka često moguće isključivo uz nadoplatu kao što je to slučaj člancima na hrvatskom jeziku kroz webhose.io servis, presscliping, presscut i mediatoolkit
U ovom ćemo predavanju analizirati tržište aparata za kavu u Hrvatskoj na osnovi osnovi svih tekstova objavljenih u svim domaćim medijima u perodu od 2021-01-09) do 2022-11-01. Članci su preuzeti strojno sa mediatoolkit servisa i na način da sadrže riječ: LatteGo, De`Longhi, Krups i Nesspreso. Na taj je način prikupljeno 290 objava koje sadrže ukupno 8.980 riječi. Analiza teksta koju ćemo provesti uključuje: čišćenje, uređivanje i prilagodbu podataka, dekriptivnu statistiku na tekstualnim podatcima, analizu sentimenta, analizu frekvencija i tematsku analizu.
Uvoz podataka
Podatci za analizu su prikupljeni na prethodno opisan način i dostupni u GitHub repozitoriju kolegija (Dta folder;korona.csv file). Podataci uključuju i članke sa nekih drugih portala, ali u kraćem vremenskom rasponu pa su izostavljeni iz analize. Učitajmo podatke:
kava <- read_excel("../Dta/kava.xlsx") #, encoding="UTF-8"
glimpse(kava)## Rows: 289
## Columns: 45
## $ DATE <chr> "2022-01-10", "2022-01-08", "2022-01-07", "2022-~
## $ TIME <chr> "09:18:45", "18:32:43", "08:00:26", "18:00:00", ~
## $ TITLE <chr> "Hello.. #hello #monday #january #winter #day #w~
## $ FROM <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8>~
## $ AUTHOR <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8>~
## $ URL <chr> "https://www.instagram.com/p/CYiubD4owlX/", "htt~
## $ URL_PHOTO <chr> "https://mediatoolkit.com/img/50x50,sc,s-3IcNbqA~
## $ SOURCE_TYPE <chr> "instagram", "twitter", "instagram", "twitter", ~
## $ GROUP_NAME <chr> "Philips", "Philips", "Philips", "Philips", "Phi~
## $ KEYWORD_NAME <chr> "Nespresso", "Nespresso", "LatteGo", "Nespresso"~
## $ FOUND_KEYWORDS <chr> "nespresso", "Nespresso", "LatteGo, lattego", "n~
## $ LANGUAGES <chr> "hr, et, no", "hr", "hr, bs", "hr, sk", "hr", "h~
## $ LOCATIONS <chr> "EE, NO, HR", "HR", "HR, BA", "SK, HR", "HR", "H~
## $ TAGS <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ MANUAL_SENTIMENT <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ AUTO_SENTIMENT <chr> "neutral", "neutral", "positive", "neutral", "ne~
## $ MENTION_SNIPPET <chr> "Hello.. #hello #monday #january #winter #day #w~
## $ REACH <dbl> 50, 0, 30, 22, NA, NA, NA, NA, 10, 77, 0, 50, 46~
## $ VIRALITY <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, 0.0000000, 0~
## $ FOLLOWERS_COUNT <dbl> 0, 9, 0, 449, NA, NA, NA, NA, 0, NA, NA, 259, NA~
## $ LIKE_COUNT <dbl> 5, NA, 3, NA, NA, NA, NA, NA, 1, 0, 0, 3, 91, 0,~
## $ COMMENT_COUNT <dbl> 0, NA, 0, NA, NA, NA, NA, NA, 0, 0, 0, 2, 16, 0,~
## $ SHARE_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, 0, 0, NA, 6,~
## $ TWEET_COUNT <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ LOVE_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ WOW_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ HAHA_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ SAD_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ ANGRY_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ TOTAL_REACTIONS_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ FAVORITE_COUNT <dbl> NA, 0, NA, 0, NA, NA, NA, NA, NA, NA, NA, NA, NA~
## $ RETWEET_COUNT <dbl> NA, 0, NA, 0, NA, NA, NA, NA, NA, NA, NA, NA, NA~
## $ VIEW_COUNT <dbl> 0, NA, 0, NA, NA, NA, NA, NA, 0, NA, NA, 0, NA, ~
## $ DISLIKE_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ COMMENTS_COUNT <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ LIKES <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ DISLIKES <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ COUNT <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REPOST_COUNT <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REDDIT_TYPE <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ REDDIT_SCORE <dbl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, ~
## $ INFLUENCE_SCORE <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 3, 1, 1, 3, 1, 1, 3, ~
## $ TWEET_TYPE <chr> NA, "ORIGINAL", NA, "ORIGINAL", NA, NA, NA, NA, ~
## $ TWEET_SOURCE_NAME <chr> NA, "Twitter Web App", NA, "Twitter for Android"~
## $ TWEET_SOURCE_URL <chr> NA, "https://mobile.twitter.com", NA, "http://tw~Nakon što smo učitali podatke u radni prostor R, potrebno je učitati i druge podatke koji su nam potrebni za ovu analizu. Osim članaka, potrebni su nam leksikoni i stop riječi. Leksikone ćemo preuzeti iz FER-ovog repozitorija, a “stop riječi” ćemo napraviti sami.
## M-Files ----
# function to parse JSON from http conenctiion
parseJSON <- function(x) {
xCon <- content(x, as = "text", type = "aplication/json", encoding = "UTF-8")
xCon <- jsonlite::fromJSON(xCon, flatten = TRUE)
xCon
}
# GET REST API function M-Files
mfiles_get <- function(token, resource){
req <- GET(url = paste0('http://server.contentio.biz/REST', resource),
add_headers('X-Authentication' = token, 'content-type' = "application/json"))
result <- parseJSON(req)
return(result)
}
# GET token M-Files
req <- POST(url = 'http://server.contentio.biz/REST/server/authenticationtokens.aspx',
config = add_headers('content-type' = "application/json"),
body = list(Username = "msagovac", Password = "Wc8O10TaHz40",
VaultGuid = "{7145BCEB-8FE2-4278-AD3B-7AE70374FF8A}",
ComputerName = "CT-VM-01"),
encode = "json", verbose())token <- parseJSON(req)[[1]]
# M-FILES DOWNLOAD FILES
mfiles_downlaod <- function(objType, objId, fileId) {
req <- GET(url = paste0('http://server.contentio.biz/REST/objects/', objType, '/',
objId, '/latest/files/',fileId , '/content'),
add_headers('X-Authentication' = token))
reqCon <- content(req, as = "text", encoding = "UTF-8")
if (is.na(reqCon)) {
reqCon <- content(req, as = "raw", encoding = "UTF-8")
reqCon <- rawToChar(reqCon, multiple = FALSE)
reqCon <- iconv(reqCon, "", "UTF-8")
}
reqCon
}
mfiles_downlaod_txt <- function(objType, objId, fileId, ext = ".csv") {
req <- GET(url = paste0('http://server.contentio.biz/REST/objects/', objType, '/',
objId, '/latest/files/',fileId , '/content'),
add_headers('X-Authentication' = token))
reqCon <- httr::content(req)
tempFileSave <- paste0(tempfile(), ext)
writeBin(reqCon, tempFileSave)
return(tempFileSave)
}
# GET classess, props and others
prop <- mfiles_get(token, "/structure/properties")
prop <- prop %>%
select(DataType, ID, Name, ObjectType) %>%
dplyr::arrange(Name)
objs <- mfiles_get(token, "/structure/objecttypes")
mfilesClass <- mfiles_get(token, "/structure/classes")
CroSentilex_n <- read.delim(mfiles_downlaod_txt("0", 136679, 136711, ext = ".txt"),
header = FALSE,
sep = " ",
stringsAsFactors = FALSE) %>%
rename(word = "V1", sentiment = "V2" ) %>%
mutate(brija = "NEG")
CroSentilex_p <- read.delim(mfiles_downlaod_txt("0", 136681, 136713, ext = ".txt"),
header = FALSE,
sep = " ",
stringsAsFactors = FALSE) %>%
rename(word = "V1", sentiment = "V2" ) %>%
mutate(brija = "POZ")
Crosentilex_sve <- rbind(setDT(CroSentilex_n), setDT(CroSentilex_p))
#head(Crosentilex_sve)
CroSentilex_Gold <- read.delim2(mfiles_downlaod_txt("0", 136680, 136712, ext = ".txt"),
header = FALSE,
sep = " ",
stringsAsFactors = FALSE) %>%
rename(word = "V1", sentiment = "V2" )
CroSentilex_Gold[1,1] <- "dati"
CroSentilex_Gold$sentiment <- str_replace(CroSentilex_Gold$sentiment , "-", "1")
CroSentilex_Gold$sentiment <- str_replace(CroSentilex_Gold$sentiment , "\\+", "2")
CroSentilex_Gold$sentiment <- as.numeric(unlist(CroSentilex_Gold$sentiment))
#head(CroSentilex_Gold)
# leksikoni
stopwords_cro <- get_stopwords(language = "hr", source = "stopwords-iso")
my_stop_words <- tibble(
word = c(
"jedan",
"e","prvi", "dva","dvije","drugi",
"tri","tre?i","pet","kod",
"ove","ova", "ovo","bez",
"evo","oko", "om", "ek",
"mil","tko","?est", "sedam",
"osam", "?im", "zbog",
"prema", "dok","zato", "koji",
"im", "?ak","me?u", "tek",
"koliko", "tko","kod","poput",
"ba?", "dakle", "osim", "svih",
"svoju", "odnosno", "gdje",
"kojoj", "ovi", "toga","ima","treba","sad","to","kad", "?e","ovaj","?ta","onda","ce","ko"
),
lexicon = "lux"
)
stop_corpus <- my_stop_words %>%
bind_rows(stopwords_cro)kava %>%
mutate(kword = case_when(grepl("latteg", MENTION_SNIPPET, ignore.case = TRUE) ~ "LatteGo",
grepl("longhi", MENTION_SNIPPET, ignore.case = TRUE) ~ "DeLonghi",
grepl("krups", MENTION_SNIPPET, ignore.case = TRUE) ~ "Krups",
grepl("Nespresso", MENTION_SNIPPET, ignore.case = TRUE) ~ "Nespresso")) -> kava
kava %>%
# filter(SOURCE_TYPE == "web" & kword == "bosch") %>%
unnest_tokens(word, MENTION_SNIPPET) %>%
anti_join(stop_corpus, by = "word") %>%
mutate(word = gsub("\\d+", NA, word)) %>%
mutate(word = gsub("^[a-zA-Z]$", NA, word)) %>%
filter(!is.na(word)) -> rijeci_cleanPrilagodba podataka
U sljedećem koraku ćemo prilagoditi podatke u tidy format koji je prikladan za analizu. Pri tome pretvaramo podatke u dataframe, izabiremo varijable za analizu, specificiramo vremenski pečat članka kao datumsku varijablu, pripisujemo id svakom članku, izabiremo vremenski raspon analize i portale:
# prilagodi podatke
newskava <- kava %>%
as.data.frame() %>%
select(TITLE,MENTION_SNIPPET, DATE, SOURCE_TYPE, AUTHOR, FROM, kword) %>%
mutate(datum = as.Date(DATE,"%Y-%m-%d")) %>%
mutate(clanak = 1:n())
# brzi pregled strukture podataka
glimpse(newskava)## Rows: 289
## Columns: 9
## $ TITLE <chr> "Hello.. #hello #monday #january #winter #day #work #l~
## $ MENTION_SNIPPET <chr> "Hello.. #hello #monday #january #winter #day #work #l~
## $ DATE <chr> "2022-01-10", "2022-01-08", "2022-01-07", "2022-01-06"~
## $ SOURCE_TYPE <chr> "instagram", "twitter", "instagram", "twitter", "forum~
## $ AUTHOR <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8><U+0001D4F8><U+0001D4F4><U+0001D4EA> <U+0001D4EB><U+0001D4F8>~
## $ FROM <chr> "anonymous_user", "Sarlo", "anonymous_user", "<U+0001D4EB><U+0001D4F8><U+0001D4F8><U+0001D4F4><U+0001D4EA> <U+0001D4EB><U+0001D4F8>~
## $ kword <chr> "Nespresso", "Nespresso", "LatteGo", "Nespresso", "Nes~
## $ datum <date> 2022-01-10, 2022-01-08, 2022-01-07, 2022-01-06, 2022-~
## $ clanak <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,~# izgled podataka
# newskava %>%
# sample_n(.,10)
datatable(newskava, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )U sljedećem koraku provodimo tokenizaciju, odnosno pretvaranje teksta na jedinice analize. U ovom slučaju su to riječi:
# tokenizacija
newskava %>%
unnest_tokens(word, MENTION_SNIPPET) -> newskava_token
#newsCOVID_token$word <- stri_encode(newsCOVID_token$word, "", "UTF-8") # prilagodi encoding
datatable(newskava_token, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )Potom valja očistiti riječi od brojeva i nepotrebnih riječi. Na tako uređenim podatcima ćemo napraviti deskriptivno- statistički pregled teksta.
## Ukloni "stop words", brojeve, veznike i pojedinačna slova
newskava_token %>%
anti_join(stop_corpus, by = "word") %>%
mutate(word = gsub("\\d+", NA, word)) %>%
mutate(word = gsub("^[a-zA-Z]$", NA, word)) %>%
drop_na(.)-> newskava_tokenTidy
datatable(newskava_tokenTidy, rownames = FALSE, filter="top", options = list(pageLength = 5, scrollX=T) )Na tako uređenim podatcima ćemo napraviti deskriptivno-statistički pregled teksta:
# DESKRIPTIVNI PREGLED PODATAKA
## Vremenski raspon analize
range(newskava_token$DATE)## [1] "2021-09-01" "2022-01-10"## Najčešće riječi
newskava_tokenTidy %>%
count(word, sort = T) %>%
head(25)## word n
## 1 hrvatska 147
## 2 nespresso 92
## 3 de’longhi 60
## 4 lattego 45
## 5 dom 35
## 6 bauhaus 33
## 7 coffee 31
## 8 kavu 31
## 9 philips 31
## 10 samsung 31
## 11 my 25
## 12 kave 21
## 13 istria 20
## 14 https 19
## 15 mikulec 19
## 16 aparat 18
## 17 citroën 18
## 18 jysk 18
## 19 kler 18
## 20 namještaja 18
## 21 pogledajte 18
## 22 qualis 18
## 23 salon 18
## 24 akcija 17
## 25 krups 17## Vizualizacija najčešćih riječi
newskava_tokenTidy %>%
count(word, sort = T) %>%
filter(n > 10) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(word, n)) +
geom_col() +
xlab(NULL) +
coord_flip() +
theme_economist()
## Vizualizacija najčešćih riječi kroz vrijeme
newskava_tokenTidy %>%
mutate(Datum = floor_date(datum, "day")) %>%
group_by(Datum) %>%
count(word) %>%
mutate(gn = sum(n)) %>%
filter(word %in% c("nespresso", "de’longhi", "lattego", "krups")) %>%
ggplot(., aes(Datum, n / gn)) +
geom_point() +
ggtitle("Učestalost korištenja kroz vrijeme") +
ylab("% ukupnih riječi") +
geom_smooth() +
facet_wrap(~ word, scales = "free_y") +
scale_y_continuous(labels = scales::percent_format())+
theme_economist()
Također je moguće napraviti i deskriptivno-statistički pregled domena:
# DESKRIPTIVNI PREGLED DOMENA
## Broj domena
newskava_tokenTidy %>%
summarise(Domena = n_distinct(SOURCE_TYPE))## Domena
## 1 6## Broj članaka po domeni
kava %>%
# drop_na(.) %>%
group_by(SOURCE_TYPE) %>%
summarise(n = n()) %>%
arrange(desc(n)) %>%
head(20)## # A tibble: 7 x 2
## SOURCE_TYPE n
## <chr> <int>
## 1 web 110
## 2 facebook 73
## 3 instagram 51
## 4 forum 44
## 5 youtube 5
## 6 twitter 4
## 7 reddit 2## Broj članaka po brandu
kava %>%
# drop_na(.) %>%
group_by(kword) %>%
summarise(n = n()) %>%
arrange(desc(n)) %>%
head(20)## # A tibble: 4 x 2
## kword n
## <chr> <int>
## 1 Nespresso 135
## 2 DeLonghi 84
## 3 Krups 35
## 4 LatteGo 35## Broj članaka po domeni
newskava %>%
mutate(Datum = floor_date(datum, "week")) %>%
group_by(Datum, SOURCE_TYPE) %>%
summarise(n = n()) %>%
ungroup() %>%
ggplot(., aes(Datum, n)) +
geom_line() +
ggtitle("Broj članaka o kafe aparatima kroz vrijeme") +
ylab("Broj članaka") +
geom_smooth() +
facet_wrap(~ SOURCE_TYPE, scales = "free_y") +
theme_economist()
## Broj članaka po brandu
newskava %>%
mutate(Datum = floor_date(datum, "week")) %>%
group_by(Datum, kword) %>%
summarise(n = n()) %>%
ungroup() %>%
ggplot(., aes(Datum, n)) +
geom_line() +
ggtitle("Članci na najvažnijim portalima") +
ylab("Broj objavljenih COVID članaka") +
geom_smooth() +
facet_wrap(~ kword, scales = "free_y") +
theme_economist()
Analiza sentimenta
Nakon uređivanja podataka i osnovnog pregleda najvažnijih riječi, dinamike kretanja članaka kroz vrijeme i pregleda deskriptivne statistike domena ćemo provesti analizu sentimenta. Za analizu sentimenta je potrebno preuzeti leksikone sentimenta koji su za hrvatski jezik dostupni kroz FER-ov Croatian Sentiment Lexicon. Analiza sentimenta i uključuje sentiment kroz vrijeme, doprinos riječi sentimentu, ‘wordCloud’ i analizu negativnosti portala.
Pogledajmo prvo kako izgledaju leksikoni (koje smo učitali na početku):
## Pregled leksikona
CroSentilex_n %>% sample_n(10)## word sentiment brija
## 1: jug 0.267830 NEG
## 2: granićev 0.369870 NEG
## 3: delicija 0.390510 NEG
## 4: popratiti 0.537450 NEG
## 5: eskapada 0.270050 NEG
## 6: besek 0.307330 NEG
## 7: azbest 0.286470 NEG
## 8: čehinja 0.413140 NEG
## 9: ostoić 0.064668 NEG
## 10: odjeljak 0.418990 NEGCroSentilex_p %>% sample_n(10)## word sentiment brija
## 1: joaquin 0.415890 POZ
## 2: aljkavost 0.095874 POZ
## 3: provladin 0.168150 POZ
## 4: uvjetovan 0.624090 POZ
## 5: narušen 0.570920 POZ
## 6: prirodoslovac 0.153720 POZ
## 7: platforma 0.518390 POZ
## 8: gould 0.586390 POZ
## 9: mandić 0.575160 POZ
## 10: vikend 0.277400 POZCrosentilex_sve %>% sample_n(10)## word sentiment brija
## 1: mahmuljin 0.037049 POZ
## 2: vogel 0.206810 POZ
## 3: odrezak 0.352550 NEG
## 4: hill 0.517380 NEG
## 5: karas 0.347810 POZ
## 6: prikupljen 0.450830 POZ
## 7: mjuzikl 0.392780 NEG
## 8: đodan 0.052148 POZ
## 9: kopljanik 0.376760 POZ
## 10: kuponski 0.288300 NEGCroSentilex_Gold %>% sample_n(10)## word sentiment
## 1 vladati 0
## 2 piće 0
## 3 pomoći 2
## 4 majka 2
## 5 operativan 0
## 6 podružnica 0
## 7 besplatan 2
## 8 znati 2
## 9 voljeti 2
## 10 slavonski 0Provjerimo kretanje sentimenta u vremenu:
## Kretanje sentimenta kroz vrijeme
vizualiziraj_sentiment <- function(dataset, frq = "week") {
dataset %>%
inner_join( Crosentilex_sve, by = "word") %>%
filter(!is.na(word)) %>%
select(word, brija, datum, sentiment) %>%
unique() %>%
spread(. , brija, sentiment) %>%
mutate(sentiment = POZ - NEG) %>%
select(word, datum, sentiment) %>%
group_by(word) %>%
mutate(count = n()) %>%
arrange(desc(count)) %>%
mutate( score = sentiment*count) %>%
ungroup() %>%
group_by(datum) %>%
arrange(desc(datum)) -> sm
sm %>%
select(datum, score) %>%
group_by(Datum = floor_date(datum, frq)) %>%
summarise(Dnevni_sent = sum(score, na.rm = TRUE)) %>%
ggplot(., aes(Datum, Dnevni_sent)) +
geom_bar(stat = "identity") +
ggtitle(paste0("Sentiment kroz vrijeme;frekvencija podataka:", frq)) +
ylab("SentimentScore") +
theme_economist()-> gg_sentiment_kroz_vrijeme_qv
gg_sentiment_kroz_vrijeme_qv
}
vizualiziraj_sentiment(newskava_tokenTidy,"week")
Korisno je i promotriti koje riječi najviše doprinose sentimentu (pozitivnom, negativnom i neutralnom):
## Doprinos sentimentu
doprinos_sentimentu <- function(dataset, no = n) {
dataset %>%
inner_join(CroSentilex_Gold, by = "word") %>%
count(word, sentiment,sort = TRUE) %>%
group_by(sentiment) %>%
top_n(no) %>%
ungroup() %>%
mutate(sentiment = case_when(sentiment == 0 ~ "NEUTRALNO",
sentiment == 1 ~ "NEGATIVNO",
sentiment == 2 ~ "POZITIVNO")) %>%
mutate(word = reorder(word, n)) %>%
ggplot(aes(word, n, fill = sentiment)) +
geom_col(show.legend = FALSE) +
ggtitle( "Doprinos sentimentu") +
labs( x = "Riječ", y = "Broj riječi") +
facet_wrap(~ sentiment, scales = "free_y") +
coord_flip() +
theme_economist() -> gg_doprinos_sentimentu
gg_doprinos_sentimentu
}
doprinos_sentimentu(newskava_tokenTidy,15)
Korisno je pogledati i WordCloud sentiment. Pogledajmo “obični” WordCloud prije toga:
## WordCloud(vulgaris)
newskava_tokenTidy %>%
anti_join(CroSentilex_Gold,by="word") %>%
count(word) %>%
arrange(desc(n)) %>%
top_n(100) %>%
with(wordcloud(word, n, max.words = 80)) 
Ovako izgleda WordCloud koji sadržava i prikaz sentimenta:
## ComparisonCloud
newskava_tokenTidy %>%
inner_join(CroSentilex_Gold,by="word") %>%
count(word, sentiment) %>%
top_n(200) %>%
mutate(sentiment = case_when(sentiment == 0 ~ "+/-",
sentiment == 1 ~ "-",
sentiment == 2 ~ "+")) %>%
acast(word ~ sentiment, value.var = "n", fill = 0) %>%
comparison.cloud(colors = c("firebrick3", "deepskyblue3","darkslategray"),
max.words = 120)
Analiza sentimenta se može iskoristiti za pregled negativnosti pojedinih brandova:
…također i pozitivnosti brandova:
## Najpozitivniji portali
CroSentilex_Gold_poz <- CroSentilex_Gold %>% filter(sentiment == 2)
newskava_tokenTidy %>%
semi_join(CroSentilex_Gold_poz, by= "word") %>%
group_by(kword) %>%
summarise(pozWords = n()) %>%
left_join(wCount, by = "kword") %>%
mutate(pozitivnostIndex = (pozWords/word)*100) %>%
arrange(desc(pozitivnostIndex)) ## # A tibble: 4 x 4
## kword pozWords word pozitivnostIndex
## <chr> <int> <int> <dbl>
## 1 DeLonghi 41 1408 2.91
## 2 LatteGo 10 547 1.83
## 3 Nespresso 20 1106 1.81
## 4 Krups 4 250 1.6Analiza važnosti pojmova
Nakon analize sentimenta je korisno analizirati i najbitnije riječi. To se radi pomoću IDF (inverse document frequency) metode. IDF metoda omogućuje identifikaciju važnih (ne nužno čestih) riječi u korpusu i može poslužiti za analizu najvažnijih pojmova po brandovima.
## Udio riječi po domenama
domenaWords <- newskava %>%
unnest_tokens(word,MENTION_SNIPPET) %>%
count(kword, word, sort = T)
ukupnoWords <- domenaWords %>%
group_by(kword) %>%
summarise(totWords = sum(n))
domenaWords <- left_join(domenaWords, ukupnoWords)
# domenaWords %>% head(15)
# domenaWords %>%
# ggplot(., aes(n/totWords, fill = domena)) +
# geom_histogram(show.legend = FALSE) +
# xlim(NA, 0.0009) +
# facet_wrap(~domena, ncol = 2, scales = "free_y")
## Najbitnije riječi po domenma
idf <- domenaWords %>%
bind_tf_idf(word, kword, n)
idf %>% head(10)## kword word n totWords tf idf tf_idf
## 1 Nespresso nespresso 181 4143 0.04368815 0.2876821 0.01256830
## 2 DeLonghi hrvatska 146 2607 0.05600307 0.6931472 0.03881837
## 3 Nespresso za 144 4143 0.03475742 0.0000000 0.00000000
## 4 Nespresso i 136 4143 0.03282645 0.0000000 0.00000000
## 5 Nespresso u 115 4143 0.02775766 0.0000000 0.00000000
## 6 Nespresso je 108 4143 0.02606807 0.0000000 0.00000000
## 7 DeLonghi u 82 2607 0.03145378 0.0000000 0.00000000
## 8 DeLonghi de’longhi 72 2607 0.02761795 1.3862944 0.03828661
## 9 LatteGo lattego 58 1088 0.05330882 1.3862944 0.07390172
## 10 Krups krups 50 1142 0.04378284 0.6931472 0.03034795# idf %>%
# select(-totWords) %>%
# arrange(desc(tf_idf))
idf %>%
arrange(desc(tf_idf)) %>%
mutate(word = factor(word, levels = rev(unique(word)))) %>%
mutate(domena = factor(kword)) %>%
group_by(domena) %>%
top_n(10,tf_idf) %>%
ungroup() %>%
ggplot(aes(word, tf_idf, fill = kword)) +
geom_col(show.legend = FALSE) +
labs(x = NULL, y = "tf-idf") +
facet_wrap(~kword, scales = "free") +
coord_flip() +
theme_economist()
nGrami
Do sada smo analizirali tekst tako da je tekst tokeniziran na jednu riječ. To može prikriti bitne nalaze do kojih je moguće doći kada se tekst tokenizira na fraze (dvije ili N riječi). U sljedećemo koraku ćemo tokenizirati tekst na bigrame (dvije riječi) kako bismo proveli frazeološku analizu. Korištenje bigrama omogućava korištenje dodatnih metoda pa ćemo provesti i analizu korelacije među riječima.
newskava_bigram <- newskava %>%
unnest_tokens(bigram, MENTION_SNIPPET, token = "ngrams", n = 2)
newskava_bigram %>% head(10)## TITLE
## 1 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 2 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 3 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 4 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 5 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 6 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 7 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 8 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 9 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## 10 Hello.. #hello #monday #january #winter #day #work #longday #nespresso #cafe #coffee #like #likesforlike #love #lovely #happiness #happyme #haveaniceday #always #week #induljonahét #imadom
## DATE SOURCE_TYPE AUTHOR FROM kword datum
## 1 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 2 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 3 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 4 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 5 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 6 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 7 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 8 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 9 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## 10 2022-01-10 instagram anonymous_user anonymous_user Nespresso 2022-01-10
## clanak bigram
## 1 1 hello hello
## 2 1 hello monday
## 3 1 monday january
## 4 1 january winter
## 5 1 winter day
## 6 1 day work
## 7 1 work longday
## 8 1 longday nespresso
## 9 1 nespresso cafe
## 10 1 cafe coffeenewskava_bigram %>%
count(bigram, sort = T) %>%
head(25)## bigram n
## 1 za kavu 64
## 2 de’longhi hrvatska 44
## 3 aparat za 36
## 4 bauhaus hrvatska 33
## 5 nespresso je 24
## 6 je u 22
## 7 istria de’longhi 20
## 8 my istria 20
## 9 jysk hrvatska 18
## 10 kler hrvatska 18
## 11 namještaja kler 18
## 12 qualis salon 18
## 13 salon namještaja 18
## 14 dom s 16
## 15 hrvatska family.hr 16
## 16 mirjanom mikulec 16
## 17 s mirjanom 16
## 18 tražimo dom 16
## 19 dom po 15
## 20 moj dom 15
## 21 za sve 15
## 22 family.hr de’longhi 14
## 23 hrvatska svijet 14
## 24 lesnina xxxl 14
## 25 philipshomeliving coffee 14newskava_bigram_sep <- newskava_bigram %>%
separate(bigram, c("word1","word2"), sep = " ")
newskava_bigram_tidy <- newskava_bigram_sep %>%
filter(!word1 %in% stop_corpus$word) %>%
filter(!word2 %in% stop_corpus$word) %>%
mutate(word1 = gsub("\\d+", NA, word1)) %>%
mutate(word2 = gsub("\\d+", NA, word2)) %>%
mutate(word1 = gsub("^[a-zA-Z]$", NA, word1)) %>%
mutate(word2 = gsub("^[a-zA-Z]$", NA, word2)) %>%
drop_na(.)
newskava_bigram_tidy_bigram_counts <- newskava_bigram_tidy %>%
count(word1, word2, sort = TRUE)
#newsCOVID_bigram_tidy_bigram_counts
bigrams_united <- newskava_bigram_tidy %>%
drop_na(.) %>%
unite(bigram, word1, word2, sep = " ")
#bigrams_united
bigrams_united %>%
count(clanak,bigram,sort = T) -> topicBigram
# Najvažniji bigrami po domenama
bigram_tf_idf <- bigrams_united %>%
count(kword, bigram) %>%
bind_tf_idf(bigram, kword, n) %>%
arrange(desc(tf_idf))
bigram_tf_idf %>%
arrange(desc(tf_idf)) %>%
mutate(bigram = factor(bigram, levels = rev(unique(bigram)))) %>%
group_by(kword) %>%
top_n(7) %>%
ungroup() %>%
ggplot(aes(bigram, tf_idf, fill = kword)) +
geom_col(show.legend = FALSE) +
labs(x = NULL, y = "tf-idf") +
facet_wrap(~kword, ncol = 2, scales = "free") +
coord_flip() +
theme_economist()
# Analiza bigramskih fraza
newskava_bigram_tidy %>%
filter(word1 == "kava") %>%
count(word1,word2,sort=T)
# Vizualiziraj bigrame
bigram_graph <- newskava_bigram_tidy_bigram_counts %>%
filter(n >50) %>%
graph_from_data_frame()
a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
ggraph(bigram_graph, layout = "fr") +
geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
arrow = a, end_cap = circle(.07, 'inches')) +
geom_node_point(color = "lightblue", size = 5) +
geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
theme_void()Provjerimo koje su riječi najviše korelirane sa izabranim ključnim riječima:
# Korelacije riječi ( R crash na T=30)
#newsCOVID_tokenTidy %>%
# filter(published == "2020-04-22") %>%
# pairwise_count(word, domena, sort = T) %>%
# filter_all(any_vars(!is.na(.))) -> pairsWords
newskava_tokenTidy %>%
# filter(datum > "2020-02-20") %>%
group_by(word) %>%
filter(n() > 20) %>%
filter(!is.na(word)) %>%
pairwise_cor(word,datum, sort = T) -> corsWords
#corsWords %>%
# filter(item1 == "oporavak")
corsWords %>%
filter(item1 %in% c("de’longhi", "krups", "lattego", "nespresso", "dom")) %>%
group_by(item1) %>%
top_n(10) %>%
ungroup() %>%
mutate(item2 = reorder(item2, correlation)) %>%
ggplot(aes(item2, correlation)) +
geom_bar(stat = "identity") +
facet_wrap(~ item1, scales = "free") +
coord_flip() +
theme_economist()
Tematska analiza
Na kraju provodimo tematsku analizu kao najsloženiji dio do sada provedene analize. Pri tome koristimo LDA (Latent Dirichlet allocation) algoritam kako bismo pronašli najvažnije riječi u algoritamski identificiranim temama. Ovdje je važno primijetiti da prije provedbe LDA modela valja tokenizirane riječi pretvoriti u matricu pojmova (document term matrix) koju ćemo kasnije koristiti kao input za LDA algoritam.
newskava_tokenTidy %>%
count(clanak, word, sort = TRUE) %>%
cast_dtm(clanak, word,n) -> dtm
newskava_LDA <- LDA(dtm, k = 4, control = list(seed = 1234))
newskava_LDA_tidy <- tidy(newskava_LDA, matrix = "beta")
#newsCOVID_LDA_tidy
newskava_terms <- newskava_LDA_tidy %>%
drop_na(.) %>%
group_by(topic) %>%
top_n(15, beta) %>%
ungroup() %>%
arrange(topic, -beta)
#newsCOVID_terms
newskava_terms %>%
mutate(term = reorder_within(term, beta, topic)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip() +
scale_x_reordered() +
theme_economist()
Tematsku analizu je moguće i napraviti na bigramski tokeniziranom tekstu. Tada je često moguće doći do preciznijih i kontekstualno relevantnijih uvida:
# Bigrami
topicBigram %>%
cast_dtm(clanak, bigram,n) -> dtmB
newskava_LDA <- LDA(dtmB, k = 4, control = list(seed = 1234))
newskava_LDA_tidy <- tidy(newskava_LDA, matrix = "beta")
#newsCOVID_LDA_tidy
newskava_terms <- newskava_LDA_tidy %>%
drop_na(.) %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)
#newsCOVID_terms
newskava_terms %>%
mutate(term = reorder_within(term, beta, topic)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip() +
scale_x_reordered() +
theme_economist()
Zaključak
U ovom smo predavanju dali uvodni pregled mogućnosti analize teksta u okviru tidytext paketa. Riječ je o skupu alata koji omogućavaju “prilagodbu” teksta u tidy format i daljnu analizu s tidyverse alatima koje smo do sada već dobro upoznali. tidytext nije jedini dostupan okvir za analizu teksta u R, već postoji i niz drugih paketa (vidi na početku) koji omogućavaju korištenje naprednijih (algoritamkskih tehnika.
U predavanju su korišteni tekstovi objavljeni na tri domaća portala o temi COVID-19 u razdoblju od prvog zabilježenog slučaja u RH do danas. Analiza je pokazala mogućnosti tekstualne analize te osnovnih tehnika i alata na aktualnom primjeru.
Analiza teksta je trenutno (brzo) rastuće istraživačko područje sa sve većim brojem primjena, novih metodoloških pristupa i perspektiva. Dostupno je mnoštvo kvalitetnih i korisnih resursa pa se zainteresiranim studentima preporuča uključivanje u ovu (vrlo perspektivnu) istraživačku paradigmu.